home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / DIRREAD.BAS < prev    next >
BASIC Source File  |  1992-04-18  |  5KB  |  160 lines
  1. DECLARE FUNCTION RStr$ (X%, LX%)
  2. DECLARE FUNCTION FmtTime$ (T%)
  3. DECLARE FUNCTION FmtDate$ (FDate%)
  4. DECLARE FUNCTION FindFirst% (Attr%, FIleName$, DEntry AS ANY)
  5. DECLARE FUNCTION FindNext% (DEntry AS ANY)
  6. DECLARE SUB PrintDirEntry (DR AS ANY, FindStatus%)
  7. DECLARE SUB SetDTA (DTA AS ANY)
  8. DECLARE SUB TransferDTA2DIR (DEntry AS ANY)
  9.  
  10. DEFINT A-Z
  11.  
  12. 'Microsoft BASIC module to read directory entries
  13. 'PROGRAM - DIR_READ.BAS
  14. 'BASIC Version 7.0 users should change the next
  15. 'line to use the QBX.BI file instead of QB.BI
  16. '$INCLUDE: 'QB.BI'
  17. TYPE DataTransferArea
  18.         Reserved1   AS STRING * 21
  19.         Attribute   AS STRING * 1
  20.         FileTime    AS INTEGER
  21.         FileDate    AS INTEGER
  22.         FileSize    AS LONG
  23.         FIleName    AS STRING * 13
  24. END TYPE
  25.  
  26. TYPE DirectoryRecord
  27.         FIleName    AS STRING * 13
  28.         FileSize    AS LONG
  29.         FileDate    AS INTEGER
  30.         FileTime    AS INTEGER
  31.         FileAttb    AS INTEGER
  32. END TYPE
  33.  
  34. DIM SHARED InRegsX AS RegTypeX
  35. DIM SHARED OutRegsX AS RegTypeX
  36. DIM SHARED DTA AS DataTransferArea
  37. DIM DirEntry AS DirectoryRecord
  38.  
  39.         CLS
  40.         INPUT "Enter file specification: "; filespec$
  41.         CALL SetDTA(DTA)
  42.  
  43.         FindStatus = FindFirst(0, filespec$, DirEntry)
  44.         CALL PrintDirEntry(DirEntry, FindStatus)
  45.         FindStatus = FindNext(DirEntry)
  46.  
  47.   'IF FindStatus <> 0 then there are no more files
  48.   '   or no match was found or no prev call to
  49.   '   FindFirst
  50.         WHILE FindStatus = 0
  51.                 CALL PrintDirEntry(DirEntry, FindStatus)
  52.                 FindStatus = FindNext(DirEntry)
  53.                 CALL SetDTA(DTA)
  54.         WEND
  55.  
  56. FUNCTION FindFirst (Attr, FIleName$, DEntry AS DirectoryRecord)
  57.         InRegsX.AX = &H4E00
  58.         InRegsX.CX = Attr
  59.  
  60. ' DOS requires an ASCIIZ string so add CHR$(0)
  61.  
  62.          Spec$ = FIleName$ + CHR$(0)
  63. ' Version 7.0 users change VARSEG to SSEG
  64.          InRegsX.DS = VARSEG(Spec$) ' Load DS:DX with
  65.          InRegsX.DX = SADD(Spec$)   ' address of Spec$
  66.          CALL InterruptX(&H21, InRegsX, OutRegsX)
  67.  
  68. ' The next line sets an error as default condition
  69.  
  70.         FindFirst = OutRegsX.AX
  71.  
  72. ' Check if carry flag is clear in the next line
  73.  
  74.         IF (OutRegsX.Flags AND 1) = 0 THEN
  75.                 CALL TransferDTA2DIR(DEntry)
  76.                 FindFirst = 0 'Clear error condition setting
  77.         END IF
  78. END FUNCTION
  79.  
  80. FUNCTION FindNext (DEntry AS DirectoryRecord)
  81.    DTA.FIleName = SPACE$(13)
  82.         InRegsX.AX = &H4F00
  83.         CALL InterruptX(&H21, InRegsX, OutRegsX)
  84.         FindNext = OutRegsX.AX
  85.         IF (OutRegsX.Flags AND 1) = 0 THEN
  86.                 CALL TransferDTA2DIR(DEntry)
  87.                 FindNext = 0
  88.         END IF
  89. END FUNCTION
  90.  
  91. FUNCTION FmtDate$ (FDate)
  92.         Day = FDate AND &H1F
  93.         Month = (FDate AND &H1E0) \ 32
  94.         Year = (FDate AND &HFE00) \ 512 + 1980
  95.         FmtDate$ = RStr$(Month, 2) + "-" + RStr$(Day, 2) + "-" + RStr$(Year, 4)
  96. END FUNCTION
  97.  
  98. FUNCTION FmtTime$ (T%)
  99.         Seconds = (T% AND &H1F) * 2
  100.         Minutes = (T% AND &H7E0) \ 32
  101.  
  102.         Hours = (T% < 0) * (-16) + ((T% AND &H7FFF) \ 2048)
  103.         Abbr$ = " am"
  104.         IF Hours = 12 THEN Abbr$ = " pm"
  105.         IF Hours = 0 THEN Hours = 12
  106.  
  107.         IF Hours > 12 THEN   'Reset to 12 hour clock
  108.                 Hours = Hours MOD 12
  109.                 Abbr$ = " pm"
  110.         END IF
  111.         FmtTime$ = RStr$(Hours, 2) + ":" + RStr$(Minutes, 2) + ":" + RStr$(Seconds, 2)
  112. END FUNCTION
  113.  
  114. SUB GetDTAAddr (Segment, Offset)  'Subprogram not used but included for your co
  115.         InRegsX.AX = &H2F00
  116.         CALL InterruptX(&H21, InRegsX, OutRegsX)
  117.         Segment = OutRegsX.ES   'Return address of DTA
  118.         Offset = OutRegsX.BX    'Segment:Offset format
  119. END SUB
  120.  
  121. SUB PrintDirEntry (DR AS DirectoryRecord, FindStatus)
  122.         FmtStr$ = "\          \  ##,###,###  " + "\        \ \           \  ###"
  123.         IF FindStatus = 0 THEN
  124.                 PRINT USING FmtStr$; DR.FIleName; DR.FileSize; FmtDate$(DR.FileDate)
  125.         ELSE
  126.                 PRINT "Error on file lookup"
  127.                 SELECT CASE FindStatus
  128.                         CASE 2
  129.                                 PRINT "File not found"
  130.                         CASE 3
  131.                                 PRINT "Path not found"
  132.                         CASE 18
  133.                                 PRINT "Match not found"
  134.                         CASE ELSE
  135.                                 PRINT "Unknown error #"; FindStatus
  136.                 END SELECT
  137.         END IF
  138. END SUB
  139.  
  140. FUNCTION RStr$ (X%, LX%)
  141.         X$ = STR$(X%)
  142.         RStr$ = RIGHT$("00000" + RIGHT$(X$, LEN(X$) - 1), LX%)
  143. END FUNCTION
  144.  
  145. SUB SetDTA (DTA AS DataTransferArea)
  146.         InRegsX.AX = &H1A00
  147.         InRegsX.DS = VARSEG(DTA)
  148.         InRegsX.DX = VARPTR(DTA)   'Use for records
  149.         CALL InterruptX(&H21, InRegsX, OutRegsX)
  150. END SUB
  151.  
  152. SUB TransferDTA2DIR (DEntry AS DirectoryRecord)
  153.         DEntry.FIleName = DTA.FIleName
  154.         DEntry.FileSize = DTA.FileSize
  155.         DEntry.FileDate = DTA.FileDate
  156.         DEntry.FileTime = DTA.FileTime
  157.         DEntry.FileAttb = ASC(DTA.Attribute)
  158. END SUB
  159.  
  160.